home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / GSDBLOOK.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-27  |  13KB  |  539 lines
  1. program GSdBLook;
  2. uses
  3.    CRT,
  4.    DOS,
  5.    GS_Lst,
  6.    GS_FileH,
  7.    GS_KeyI,
  8.    GS_dBFld,
  9.    GS_Pick,
  10.    GS_Winfc,
  11.    GS_dBTbl,
  12.    GS_dBase;
  13.  
  14. const
  15.  
  16.    Initial_Count  = 7;
  17.    Initial_Choice : array [1..Initial_Count] of string[9] =
  18.                     (' Edit',' Append',' Select',' Print',
  19.                     ' Pack',' Info',' Exit');
  20.  
  21. type
  22.    Look_Obj  = object(GS_dBFld_Objt)
  23.                   constructor Init(FName : string);
  24.                   procedure   StatusUpdate(statword1,statword2,
  25.                                             statword3 : longint); virtual;
  26.                end;
  27.  
  28. var
  29.    Look      : Look_Obj;
  30.    LookIndex,
  31.    LookName  : string;
  32.    CreditWin,
  33.    FileWin,
  34.    FieldWin,
  35.    PrintWin,
  36.    AskWin,
  37.    StatusWin,
  38.    TalkWin,
  39.    LookWin   : GS_Wind_Objt;
  40.    LookTab   : dbTabl_Pick_Obj;
  41.    L         : PathStr;
  42.  
  43.  
  44. constructor Look_Obj.Init(FName : string);
  45. begin
  46.    GS_dBFld_Objt.Init(FName);
  47.    TalkWin.InitWin(10,10,70,15,Blue,LightGray,Yellow,LightGray,Black,true,
  48.                   '',true);
  49. end;
  50.  
  51. procedure Look_Obj.StatusUpdate(statword1,statword2,statword3 : longint);
  52. begin
  53.    case statword1 of
  54.       StatusStart   : begin
  55.                          case statword2 of
  56.                             StatusPack  : TalkWin.NamWin('[ Pack Progress ]');
  57.                             StatusIndexTo : TalkWin.NamWin
  58.                                                     ('[ Index Progress ]');
  59.                          end;
  60.                          TalkWin.SetWin;
  61.                          GotoXY(26,3);
  62.                          write('Total Records to Process = ',statword3);
  63.                       end;
  64.       StatusStop    : TalkWin.RelWin;
  65.       StatusPack,
  66.       StatusIndexTo : begin
  67.                          GoToXy(2,3);
  68.                          write('Record Number ',statword2,'  ');
  69.                       end;
  70.    end;
  71. end;
  72.  
  73.  
  74.  
  75. function SelField(MemoOk : boolean) : string;
  76. var
  77.   FilTabl : array[1..128] of string[12];
  78.   Labl    : string;
  79.   itms    : integer;
  80.   slct    : integer;
  81.   lctn    : integer;
  82. begin
  83.    itms := 0;
  84.    lctn := 0;
  85.    while itms < Look.NumFields do
  86.    begin
  87.       inc(itms);
  88.       if MemoOk then
  89.       begin
  90.          inc(lctn);
  91.          FilTabl[lctn] := Look.FieldsN^[itms];
  92.       end
  93.       else
  94.       begin
  95.          if Look.Fields^[itms].FieldType <> 'M' then
  96.          begin
  97.             inc(lctn);
  98.             FilTabl[lctn] := Look.FieldsN^[itms];
  99.          end;
  100.       end;
  101.    end;
  102.    FieldWin.SetWin;
  103.    slct := GS_Pick_Row_Item(FilTabl, 13, lctn, 1);
  104.    FieldWin.RelWin;
  105.    if slct > 0 then Labl := FilTabl[slct] else Labl := '';
  106.    SelField := Labl;
  107. end;
  108.  
  109.  
  110. function GetExt(pth, ext : string; LookElseWhere : boolean) : string;
  111. var
  112.    Labl : string;
  113. begin
  114.    FileWin.SetWin;
  115.    Labl := GS_FileFindFiles(pth,ext,LookElseWhere);
  116.    FileWin.RelWin;
  117.    if Labl = '-' then Labl := '';
  118.    GetExt := Labl;
  119. end;
  120.  
  121.  
  122. procedure FileEdit;
  123. var
  124.    i,
  125.    ml : integer;
  126.    vl,
  127.    vs : boolean;
  128.    aw : string[1];
  129. begin
  130.    StatusWin.SetWin;
  131.    write('':10,'ESC to Abort,  F10 For Next Record,',
  132.                '  F9 to Delete/Undelete');
  133.    LookWin.SetWin;
  134.    if Look.RecNumber < 1 then
  135.       Look.GetRec(Top_Record)
  136.    else
  137.       Look.GetRec(Look.RecNumber);
  138.    vl := true;
  139.    while vl do
  140.    begin;
  141.       ClrScr;
  142.       begin
  143.          vs := false;
  144.          vl := Look.FieldUpdateScreen;
  145.          if not vl then
  146.          begin
  147.             if Look.RecChanged then
  148.             begin
  149.                AskWin.NamWin('');
  150.                AskWin.SetWin;
  151.                gotoxy(1,1);
  152.                writeln(' Record has been modified!');
  153.                write(' Save before exit? ');
  154.                aw := Look.EditString('Y',21,2,1);
  155.                vs := aw[1] in ['T','t','Y','y'];
  156.                AskWin.RelWin;
  157.             end;
  158.          end;
  159.          if vl or vs then
  160.          begin
  161.             Look.PutRec(Look.RecNumber);
  162.             if GS_KeyI_Chr = Kbd_PgUp then
  163.                Look.GetRec(Prev_Record)
  164.             else
  165.                Look.GetRec(Next_Record);
  166.          end;
  167.       end;
  168.    end;
  169.    LookWin.RelWin;
  170.    StatusWin.RelWin;
  171. end;
  172.  
  173. procedure FileAppend;
  174. var
  175.    i,
  176.    ml : integer;
  177.    vc,
  178.    vl,
  179.    vs : boolean;
  180.    aw : string[1];
  181. begin
  182.    StatusWin.SetWin;
  183.    write('':10,'ESC to Quit,  F10 For Next Record,',
  184.                '  F9 to Delete/Undelete');
  185.    LookWin.SetWin;
  186.    Look.GetRec(Top_Record);
  187.    vl := true;
  188.    vc := true;
  189.    while vl do
  190.    begin;
  191.       ClrScr;
  192.       begin
  193.          vs := false;
  194.          vl := Look.FieldAppendScreen(vc);
  195.          vc := false;
  196.          if not vl then
  197.          begin
  198.             if Look.RecChanged then
  199.             begin
  200.                AskWin.NamWin('');
  201.                AskWin.SetWin;
  202.                gotoxy(1,1);
  203.                writeln(' Record has been modified!');
  204.                write(' Save before exit? ');
  205.                aw := Look.EditString('Y',21,2,1);
  206.                vs := aw[1] in ['T','t','Y','y'];
  207.                AskWin.RelWin;
  208.             end;
  209.          end;
  210.          if vl or vs then
  211.          begin
  212.             Look.Append;
  213.             LookTab.Reset_dBTabl;
  214.          end;
  215.       end;
  216.    end;
  217.    LookWin.RelWin;
  218.    StatusWin.RelWin;
  219. end;
  220.  
  221. procedure ShowFile;
  222. var
  223.    i,
  224.    ml : integer;
  225.    vl,
  226.    vs : boolean;
  227.    aw : string[1];
  228. begin
  229.    StatusWin.SetWin;
  230.    write('':10,'ESC to Abort,  F10 to Quit and Save,',
  231.                '  F9 to Delete/Undelete');
  232.    LookWin.SetWin;
  233.    vl := true;
  234.    begin;
  235.       ClrScr;
  236.       if LookTab.Addrec then
  237.       begin
  238.          vs := false;
  239.          vl := Look.FieldAppendScreen(true);
  240.          if not vl then
  241.          begin
  242.             if Look.RecChanged then
  243.             begin
  244.                AskWin.NamWin('');
  245.                AskWin.SetWin;
  246.                gotoxy(1,1);
  247.                writeln(' Record has been modified!');
  248.                write(' Save before exit? ');
  249.                aw := Look.EditString('Y',21,2,1);
  250.                vs := aw[1] in ['T','t','Y','y'];
  251.                AskWin.RelWin;
  252.             end;
  253.          end;
  254.          if vl or vs then
  255.          begin
  256.             Look.Append;
  257.             LookTab.Reset_dBTabl;
  258.          end;
  259.       end
  260.       else
  261.       begin
  262.          vs := false;
  263.          vl := Look.FieldUpdateScreen;
  264.          if not vl then
  265.          begin
  266.             if Look.RecChanged then
  267.             begin
  268.                AskWin.NamWin('');
  269.                AskWin.SetWin;
  270.                gotoxy(1,1);
  271.                writeln(' Record has been modified!');
  272.                write(' Save before exit? ');
  273.                aw := Look.EditString('Y',21,2,1);
  274.                vs := aw[1] in ['T','t','Y','y'];
  275.                AskWin.RelWin;
  276.             end;
  277.          end;
  278.          if vl or vs then
  279.          begin
  280.             Look.PutRec(Look.RecNumber);
  281.             if GS_KeyI_Chr = Kbd_PgUp then
  282.                Look.GetRec(Prev_Record)
  283.             else
  284.                Look.GetRec(Next_Record);
  285.          end;
  286.       end;
  287.    end;
  288.    LookWin.RelWin;
  289.    StatusWin.RelWin;
  290. end;
  291.  
  292.  
  293.  
  294. procedure FileDisplay;
  295. var
  296.    t : string[8];
  297.    fn : string[12];
  298.    i : integer;
  299.    z,
  300.    wcr : boolean;
  301. begin
  302.    fn := SelField(false);
  303.    if fn = '' then exit;
  304.    wcr := Look.Wait_CR;
  305.    Look.Wait_Cr := true;
  306.    AskWin.NamWin('[ Search Criteria ]');
  307.    AskWin.SetWin;
  308.    gotoxy(1,1);
  309.    write('Enter select criteria:');
  310.    t := Look.EditString('',8,2,20);
  311.    Look.Wait_CR := wcr;
  312.    AskWin.RelWin;
  313.    if GS_KeyI_Esc then exit;
  314.    LookTab.Reset_dBTabl;
  315.    repeat
  316.       StatusWin.SetWin;
  317.       write('':22,'ESC to Exit,  RETURN to Select Entry');
  318.       if LookTab.Tabl = nil then
  319.          z := LookTab.Scan_dBTabl(fn,t,fn)
  320.       else
  321.       begin
  322.          LookTab.Pick_Win.SetWin;
  323.          z := LookTab.Choose_dBTabl;
  324.          LookTab.Pick_Win.RelWin;
  325.       end;
  326.       StatusWin.RelWin;
  327.       if z then ShowFile;
  328.    until not z;
  329.    LookTab.Reset_dBTabl;
  330. end;
  331.  
  332. procedure Print_List;
  333. var
  334.    i,
  335.    ml,
  336.    lines : integer;
  337.    swork : string;
  338.    vs    : boolean;
  339.